home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 6 / The Arsenal Files 6 (Arsenal Computer).ISO / prg_basi / n_b-v200.zip / NBV2 / DMO / CGB_ALL.DMO < prev    next >
Text File  |  1996-03-11  |  10KB  |  178 lines
  1. $if 0
  2.     ┌──────────────────────────╖                        PowerBASIC v3.20
  3.  ┌──┤          DASoft          ╟──────────────────────┬──────────────────╖
  4.  │  ├──────────────────────────╢    Copyright 1995    │ DATE: 1995-10-01 ╟─╖
  5.  │  │ FILE NAME   CGB_ALL .DMO ║          by          ╘════════════════─ ║ ║
  6.  │  │                          ║  Don Schullian, Jr.                     ║ ║
  7.  │  ╘══════════════════════════╝                                         ║ ║
  8.  │ A license is hereby granted to the holder to use this source code in  ║ ║
  9.  │ any program, commercial or otherwise,  without receiving the express  ║ ║
  10.  │ permission of the copyright holder and without paying any royalties,  ║ ║
  11.  │ as long as this code is not distributed in any compilable format.     ║ ║
  12.  │  IE: source code files, PowerBASIC Unit files, and printed listings   ║ ║
  13.  ╘═╤═════════════════════════════════════════════════════════════════════╝ ║
  14.    │                ....................................                   ║
  15.    ╘═══════════════════════════════════════════════════════════════════════╝
  16. $endif
  17.  
  18. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  19. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  20.                                            '┌────────────────────────────────
  21. $INCLUDE "DAS-NB01.INC"                    '│
  22. $INCLUDE "DAS-NB02.INC"                    '│
  23. $INCLUDE "DAS-NBV1.INC"                    '│
  24. $INCLUDE "DAS-NBV2.INC"                    '│
  25.                                            '│
  26. %ALT_X = &h2D00                            '│ CVI( CHR$(0,45) )
  27.                                            '│
  28. CLS                                        '│
  29. IF fMouseSETUP?(0) = 0 THEN                '│ gotta have a mouse
  30.   PRINT "CAN'T RUN THIS WITHOUT A MOUSE"   '│
  31.   END                                      '│
  32. END IF                                     '│
  33. IF fDESQview% > 0 THEN                     '│ DESQview & DAC routines
  34.   PRINT "CAN'T RUN THIS WITH DESQ-VIEW"    '│ collide some times
  35.   END                                      '│
  36. END IF                                     '│
  37.                                            '│
  38. SCREEN 12                                  '│ all systems <<GO>>
  39. GraphicSETUP                               '│ set-up for DASoft's graphics
  40. EventSETUP 1, 20                           '│ set-up events
  41. Blank$ = STRING$( 192, 63 )                '│ a flock of 63's for the DAC
  42. DACwriteSTR Blank$                         '│ eveything's white while we draw
  43.                                            '│
  44. Mask$ = fMonoMask$( 94 )                   '│ load a monochrome mask
  45. Mask$ = fColorMask$( Mask$, 3, 8 )         '│ make it a 2color mask
  46. PAINT (0,0), Mask$                         '│ paint the whole screen
  47. GBoxFFRAME 200, 5, 414, 42, 4, 9, 14, 0, 0 '│ title box
  48. LOCATE 2, 28                               '│
  49. PRINT "Graphic Screen Clearing"            '│
  50. GBoxCOLOR2 200, 5, 414, 42, 0, 4           '│ re-color the background
  51.                                            '│
  52. RESTORE DEMODATA                           '│ better safe than sorry
  53. DIM E%(3,17)                               '│ our event array
  54. A? = 0                                     '│
  55. FOR E% = 1 TO 17                           '│ read data & create the screen
  56.   READ M$, Trow?, Tcol?                    '│ msg and text addresses
  57.   FOR X% = 0 TO 3                          '│ event box addresses
  58.     READ E%(X%,E%)                         '│
  59.   NEXT                                     '│
  60.   IF E% = 17 THEN A? = 1                   '│ box 17 is red
  61.   GBoxBEVELA E%(0,E%), 5, A?, A?+5, A?+10  '│ draw the box
  62.   LOCATE Trow?, Tcol? : PRINT M$           '│ print the message
  63. NEXT                                       '│
  64. GBoxCOLOR2 E%(0,17),E%(1,17), _            '│ re-color the background again
  65.            E%(2,17),E%(3,17), 0, 1         '│
  66.                                            '│
  67. DIM P0%(19201), P1%(19201)                 '│ arrays to save the screen
  68. DIM P2%(19201), P3%(19201)                 '│ plane by plane
  69. DIM P???(3)                                '│ pointers to the arrays so
  70. P???(0) = VARPTR32( P0%(0) )               '│ we can put them into a loop
  71. P???(1) = VARPTR32( P1%(0) )               '│
  72. P???(2) = VARPTR32( P2%(0) )               '│
  73. P???(3) = VARPTR32( P3%(0) )               '│
  74. GOSUB SaveScreen                           '│ read screen data
  75. E%(2,0) = 639 : E%(3,0) = 479              '│ whole screen is the event
  76. fEventOpenG E%(0,0), 17                    '│ open the event
  77. fLoadDAScolor                              '│ re-color screen
  78. MouseMakePtr "INVARROW"                    '│ new pointer for the rat
  79.                                            '│
  80. DO                                         '│ menu loop
  81.   MouseONnow                               '│
  82.   G% = fEventKey%( Hit%, CHR$(0,45) )      '│ await action!
  83.   MouseOFF                                 '│ mouse off for now!
  84.   IF ( G%   = %ALT_X ) OR _                '│ <ALT><X>
  85.      ( Hit% = 17     ) THEN EXIT LOOP      '│ <RED BUTTON>
  86.   SELECT CASE Hit%                         '│
  87.     CASE < 0                               '│ no action on MOUSE DOWN
  88.       ITERATE                              '│
  89.     CASE 01                                '│
  90.       ClearGBoxDN    0,0,639,479,0,Noise%  '│
  91.     CASE 02                                '│
  92.       ClearGBoxLF    0,0,639,479,0,Noise%  '│
  93.     CASE 03                                '│
  94.       ClearGBoxZIO   0,0,639,479,0,Noise%  '│
  95.     CASE 04                                '│
  96.       ClearGBoxDIO   0,0,639,479,0,Noise%  '│
  97.     CASE 05                                '│
  98.       ClearGBoxVBH   0,0,639,479,0,Noise%  '│
  99.     CASE 06                                '│
  100.       ClearGBoxDDN   0,0,639,479,0,Noise%  '│
  101.     CASE 07                                '│
  102.       ClearGBoxCLOCK 0,0,639,479,0,Noise%  '│
  103.     CASE 08                                '│
  104.       ClearGBoxUP    0,0,639,479,0,Noise%  '│
  105.     CASE 09                                '│
  106.       ClearGBoxRT    0,0,639,479,0,Noise%  '│
  107.     CASE 10                                '│
  108.       ClearGBoxZOI   0,0,639,479,0,Noise%  '│
  109.     CASE 11                                '│
  110.       ClearGBoxDOI   0,0,639,479,0,Noise%  '│
  111.     CASE 12                                '│
  112.       ClearGBoxVBV   0,0,639,479,0,Noise%  '│
  113.     CASE 13                                '│
  114.       ClearGBoxDUP   0,0,639,479,0,Noise%  '│
  115.     CASE 14                                '│
  116.       ClearGBoxSWEEP 0,0,639,479,0,Noise%  '│
  117.     CASE 15                                '│
  118.       ClearGBoxRND   0,0,639,479,0,Noise%  '│
  119.     CASE 16                                '│
  120.       Noise% = ( Noise% = 0 )              '│ change sound setting
  121.       LOCATE 18, 45                        '│
  122.       IF Noise% THEN ? "N " ELSE ? "FF"    '│ change message
  123.       GOSUB SaveScreen                     '│
  124.       ITERATE                              '│ no screen blanking
  125.   END SELECT                               '│
  126.   DELAY 1                                  '│ pause for effect
  127.   DACwriteSTR Blank$                       '│ everything white again
  128.   FOR P? = 0 TO 3                          '│ put the screen back
  129.     PutParr 0, 0, BYVAL P???(P?), 3, P?    '│
  130.   NEXT                                     '│
  131.   fLoadDAScolor                            '│ recolor the screen
  132. LOOP                                       '│
  133.                                            '│
  134. CLS : PALETTE : SCREEN 0                   '└─────────────────────────────────
  135. END
  136.  
  137. ' ═══════════════════════════════════════════════════════════════════════════
  138. ' ══════════ local stuff from here down ═════════════════════════════════════
  139. ' ═══════════════════════════════════════════════════════════════════════════
  140.                                                '┌────────────────────────────
  141. FUNCTION fGetKey% () LOCAL PUBLIC              '│ This is what fGetKey%
  142.   LOCAL G%                                     '│ looks like when using
  143.                                                '│ fEventKey% the only
  144.   DO                                           '│ difference is that its
  145.     IF INSTAT THEN G% = CVI(INKEY$ + CHR$(0))  '│ for kbrd and/or mouse
  146.   LOOP UNTIL ( G%            <> 0  ) OR _      '│
  147.              ( fMouseGetKey% <> 0  )           '│ change this to > 0
  148.   FUNCTION = G%                                '│ if you only want
  149.                                                '│ clicks
  150. END FUNCTION                                   '│
  151. ' ──────────────────────────────────────────────┼───────────────────────────
  152. SAVESCREEN:                                    '│
  153.   FOR P? = 0 TO 3                              '│ read screen data
  154.     fGetParr 0, 0, 639, 479,BYVAL P???(P?),P?  '│ from all 4 planes
  155.   NEXT                                         '│
  156. RETURN                                         '│
  157. ' ──────────────────────────────────────────────┴───────────────────────────
  158. ' ──────── box data
  159. ' ──────────────────────────────────────────────────────────────────────────
  160. DEMODATA:
  161.   DATA "  Top to Bottom   ", 07, 18, 122,  87, 291, 120
  162.   DATA "  Left to Right   ", 10, 12,  74, 135, 243, 168
  163.   DATA "Zoom Inside/Out B ", 13, 06,  26, 183, 195, 216
  164.   DATA "Zoom Inside/Out D ", 16, 04,  10, 231, 179, 264
  165.   DATA "Venetian Blinds H ", 19, 06,  26, 279, 195, 312
  166.   DATA "Diagonal Top/Down ", 22, 12,  74, 327, 243, 360
  167.   DATA "   Single Sweep   ", 25, 18, 122, 375, 291, 408
  168.   DATA "  Bottom to Top   ",  7, 46, 347,  87, 516, 120
  169.   DATA "  Right to Left   ", 10, 52, 395, 135, 564, 168
  170.   DATA "Zoom Outside/In B ", 13, 58, 443, 183, 614, 216
  171.   DATA "Zoom Outside/In D ", 16, 60, 459, 231, 628, 264
  172.   DATA "Venetian Blinds V ", 19, 58, 443, 279, 614, 312
  173.   DATA "Diagonal Bottom/Up", 22, 52, 395, 327, 564, 360
  174.   DATA "   Double Sweep   ", 25, 46, 347, 375, 516, 408
  175.   DATA "  Random Blocks   ", 14, 32, 235, 199, 404, 232
  176.   DATA "   Sound is OFF   ", 18, 32, 235, 263, 404, 296
  177.   DATA "Exit To DOS"       , 29, 67, 514, 438, 629, 471
  178.